home *** CD-ROM | disk | FTP | other *** search
/ Aminet 3 / Aminet 3 - July 1994.iso / Aminet / dev / m2 / Modules.lha / Modules / IntuitionSupport / IntuitionDemo.mod / IntuitionDemo.mod
Encoding:
Text File  |  1993-12-22  |  8.8 KB  |  213 lines
  1. MODULE IntuitionDemo;
  2.  
  3. (* Dieses Demo veranschaulicht die Benutzung der Requester und Gadget *)
  4. (* Routinen aus dem Modul IntuitionSupport. Auf diesem Demo liegt     *)
  5. (* kein Copyright!                                                    *)
  6.  
  7. FROM SYSTEM           IMPORT ADR,ASSEMBLE,ADDRESS;
  8. FROM IntuitionSupport IMPORT CreateSimpleWindow,GetRequester,GadgetsPtr,
  9.                              AddBorderBoolGadget,InitGadgetList,GadgetHandlePtr,
  10.                              GetBorder,FreeRequester,AddIntuiText,FreeBorder,
  11.                              RequestFlags,RequestFlagSet,GetRectBorder,GetImage,
  12.                              BoolGadgetFlagSet,BoolGadgetFlags,MessageType,
  13.                              stdFont,stdHeight,BorderPtr,DisplayAllGadgets,
  14.                              WaitForPossibleAction,FreeGadgetList,DeleteWindow,
  15.                              CreateSimpleScreen,DeleteScreen,FreeIntuiTextList,
  16.                              GetGadgetSelection,EndDMRequester,ExclIDCMPFlag,
  17.                              GetColorImage,AddImageBoolGadget,SetPropGadget,
  18.                              GetPropPosition,GetReqRastPort,AddPropGadget,
  19.                              PropGadgetFlags,PropGadgetFlagSet,NewGetRectBorder,
  20.                              InclIDCMPFlag;
  21. FROM IntuitionD       IMPORT WindowPtr,RequesterPtr,IntuiTextPtr,ScreenPtr,
  22.                              IDCMPFlagSet,IDCMPFlags,WindowFlags,WindowFlagSet,
  23.                              ImagePtr;
  24. FROM IntuitionL       IMPORT DrawBorder,DrawImage;
  25. FROM GraphicsD        IMPORT FontStyleSet,jam2,jam1,RastPortPtr;
  26. FROM GraphicsL        IMPORT LoadRGB4,SetRGB4,RectFill,SetAPen,Move,Text;
  27.  
  28.  
  29.  
  30. (*$ EntryExitCode:=FALSE *)
  31. PROCEDURE Colors;
  32. BEGIN
  33.   ASSEMBLE(
  34.     DC.W $AAA,$FFF,$000,$C00,$F0F,$FF0,$F85,$0F0
  35.     DC.W $72D,$7BF,$444,$666,$888,$CCC,$EEE,$FFF
  36.   END);
  37. END Colors;
  38.  
  39.  
  40.  
  41. VAR scr         : ScreenPtr;
  42.     win         : WindowPtr;
  43.     req         : RequesterPtr;
  44.     rp          : RastPortPtr;
  45.     glr,glw     : GadgetHandlePtr;
  46.     it          : IntuiTextPtr;
  47.     mt          : MessageType;
  48.     idcmp       : IDCMPFlagSet;
  49.     cim,sim     : ImagePtr;
  50.     im          : ARRAY[0..2] OF ImagePtr;
  51.     gf          : ARRAY[0..15] OF GadgetsPtr;
  52.     copy        : ARRAY[0..15] OF CARDINAL;
  53.     cm          : POINTER TO ARRAY[0..15] OF CARDINAL;
  54.     end         : BOOLEAN;
  55.     xr,xg,xb,yp : CARDINAL;
  56.     id,t,actCol : INTEGER;
  57.     gr,gg,gb,gc,go,gw : GadgetsPtr;
  58.     border,bgad,bgads,bcol,bww1,bww2,bcgad,bcgads : BorderPtr;
  59.  
  60.  
  61.  
  62. PROCEDURE SetPropGadgets(color : CARDINAL);
  63. BEGIN
  64.   SetPropGadget(gr,16,0,1,0,(color DIV 256) MOD 16,0);
  65.   SetPropGadget(gg,16,0,1,0,(color DIV 16) MOD 16,0);
  66.   SetPropGadget(gb,16,0,1,0,color MOD 16,0);
  67. END SetPropGadgets;
  68.  
  69.  
  70.  
  71. BEGIN
  72.  
  73.   scr:=CreateSimpleScreen(640,256,4,
  74.          ADR("DMRequesterDemo  IntuitionSupport © 1992 by Andre Wiethoff"),2);
  75.  
  76.   IF scr#NIL THEN
  77.     border:=NewGetRectBorder(1,2,jam2,0,0,9,8,NIL);
  78.     DrawBorder(ADR(scr^.rastPort),ADDRESS(border),100,100);
  79.     FOR t:=0 TO 2 DO
  80.       im[t]:=GetImage(ADR(scr^.rastPort),100,100,10,9,0,0,NIL);
  81.     END;
  82.     FreeBorder(border);
  83.  
  84.     win:=CreateSimpleWindow(0,0,640,256,NIL,
  85.          WindowFlagSet{activate,borderless,backDrop},scr);
  86.  
  87.     cm:=scr^.viewPort.colorMap^.colorTable;
  88.     LoadRGB4(ADR(scr^.viewPort),ADR(Colors),16);
  89.  
  90.     (* Die folgenden Befehle könnten durch den Befehl 'WriteText' aus *)
  91.     (* dem Modul GraphicsSupport ersetzt werden.                      *)
  92.     SetAPen(win^.rPort,1);
  93.     Move(win^.rPort,120,50);
  94.     Text(win^.rPort,ADR("Dieses Demo verwendet nur Kickstart V1.2 Routinen!"),50);
  95.     Move(win^.rPort,140,60);
  96.     Text(win^.rPort,ADR("Bitte doppelklicken Sie die rechte Maustaste!"),45);
  97.  
  98.     IF win#NIL THEN
  99.       glw:=InitGadgetList(win,NIL,stdFont,stdHeight,FontStyleSet{});
  100.       bww1:=NewGetRectBorder(1,2,jam2,-1,-1,160,30,NIL);
  101.       bww2:=NewGetRectBorder(2,1,jam2,-1,-1,160,30,NIL);
  102.       gw:=AddBorderBoolGadget(glw,240,100,160,30,400,bww1,bww2,
  103.                               BoolGadgetFlagSet{},jam1,1,0,"Beende Demo");
  104.       DisplayAllGadgets(glw);
  105.  
  106.       border:=NewGetRectBorder(1,2,jam2,0,0,319,99,NIL);
  107.       border:=NewGetRectBorder(2,1,jam2,220,74,307,92,border);
  108.       border:=NewGetRectBorder(2,1,jam2,84,4,236,15,border);
  109.       border:=NewGetRectBorder(2,1,jam2,64,19,205,29,border);
  110.       border:=NewGetRectBorder(2,1,jam2,64,31,205,41,border);
  111.       border:=NewGetRectBorder(2,1,jam2,64,43,205,53,border);
  112.       border:=NewGetRectBorder(2,1,jam2,10,19,52,29,border);
  113.       border:=NewGetRectBorder(2,1,jam2,10,31,52,41,border);
  114.       border:=NewGetRectBorder(2,1,jam2,10,43,52,53,border);
  115.  
  116.       bgad:=NewGetRectBorder(1,2,jam2,-1,-1,91,32,NIL);
  117.       bgads:=NewGetRectBorder(2,1,jam2,-1,-1,91,32,NIL);
  118.       bcgad:=NewGetRectBorder(1,2,jam2,0,0,21,11,NIL);
  119.       bcgads:=NewGetRectBorder(2,1,jam2,0,0,21,11,NIL);
  120.  
  121.       it:=AddIntuiText(88,6,1,0,jam2,NIL,"Color-DM-Requester",NIL);
  122.       it:=AddIntuiText(20,21,1,0,jam2,NIL,"Rot",it);
  123.       it:=AddIntuiText(16,33,1,0,jam2,NIL,"Grün",it);
  124.       it:=AddIntuiText(16,45,1,0,jam2,NIL,"Blau",it);
  125.  
  126.       glr:=InitGadgetList(NIL,NIL,stdFont,stdHeight,FontStyleSet{});
  127.       IF glr#NIL THEN
  128.         actCol:=0;
  129.         gr:=AddPropGadget(glr,65,20,140,9,100,im[0],NIL,PropGadgetFlagSet{
  130.                           pgFollow,pgBorderless},16,0,1,0,
  131.                           (cm^[actCol] DIV 256) MOD 16,0);
  132.         gg:=AddPropGadget(glr,65,32,140,9,101,im[1],NIL,PropGadgetFlagSet{
  133.                           pgFollow,pgBorderless},16,0,1,0,
  134.                           (cm^[actCol] DIV 16) MOD 16,0);
  135.         gb:=AddPropGadget(glr,65,44,140,9,102,im[2],NIL,PropGadgetFlagSet{
  136.                           pgFollow,pgBorderless},16,0,1,0,cm^[actCol] MOD 16,0);
  137.         gc:=AddBorderBoolGadget(glr,10,60,91,32,200,bgad,bgads,
  138.                           BoolGadgetFlagSet{bgInversid},jam1,2,0,"CANCEL");
  139.         gc:=AddBorderBoolGadget(glr,114,60,91,32,201,bgad,bgads,
  140.                           BoolGadgetFlagSet{bgInversid},jam1,2,0,"OK");
  141.  
  142.         cim:=NIL;
  143.         FOR t:=0 TO 15 DO
  144.           cim:=GetColorImage(20,10,(t MOD 4)*22+1,(t DIV 4)*12+1,t,cim);
  145.           gf[t]:=AddBorderBoolGadget(glr,220+(t MOD 4)*22,19+(t DIV 4)*12,
  146.                                      20,10,300+t,bcgad,bcgads,
  147.                                      BoolGadgetFlagSet{},jam1,2,0,"");
  148.         END;
  149.  
  150.         req:=GetRequester(win,-160,-75,320,100,border,it,glr,NIL,
  151.                           RequestFlagSet{relDMRequester,noisy},0);
  152.         IF req#NIL THEN
  153.  
  154.           FOR t:=0 TO 15 DO copy[t]:=cm^[t]; END;
  155.           end:=FALSE;
  156.           REPEAT
  157.             mt:=WaitForPossibleAction(win,idcmp);
  158.             CASE mt OF
  159.             |otherStuff :     GetPropPosition(gr,xr,yp); (* mouseMove *)
  160.                               GetPropPosition(gg,xg,yp);
  161.                               GetPropPosition(gb,xb,yp);
  162.                               SetRGB4(ADR(scr^.viewPort),actCol,xr,xg,xb);
  163.             |requesterSet :   rp:=GetReqRastPort(req);
  164.                               IF rp#NIL THEN  (* !!! *)
  165.                                 SetAPen(rp,actCol);
  166.                                 RectFill(rp,221,75,306,91);
  167.                                 DrawImage(rp,cim,220,19);
  168.                               END;
  169.             |gadgetReleased : IF NOT GetGadgetSelection(win,id) THEN
  170.                                 IF id<200 THEN
  171.                                   GetPropPosition(gr,xr,yp);
  172.                                   GetPropPosition(gg,xg,yp);
  173.                                   GetPropPosition(gb,xb,yp);
  174.                                   SetRGB4(ADR(scr^.viewPort),actCol,xr,xg,xb);
  175.                                 ELSIF id=200 THEN
  176.                                   LoadRGB4(ADR(scr^.viewPort),ADR(copy),16);
  177.                                   SetPropGadgets(cm^[actCol]);
  178.                                 ELSIF id=201 THEN
  179.                                   EndDMRequester(req);
  180.                                   FOR t:=0 TO 15 DO copy[t]:=cm^[t]; END;
  181.                                 ELSIF (id>=300) AND (id<400) THEN
  182.                                   actCol:=id-300;
  183.                                   rp:=GetReqRastPort(req);
  184.                                   IF rp#NIL THEN (* !!! *)
  185.                                     SetAPen(rp,actCol);
  186.                                     RectFill(rp,221,75,306,91);
  187.                                   END;
  188.                                   SetPropGadgets(cm^[actCol]);
  189.                                 ELSIF id=400 THEN
  190.                                   (* befindet sich im selben Window! *)
  191.                                   EndDMRequester(req);
  192.                                   end:=TRUE;
  193.                                 END;
  194.                               END;
  195.             ELSE
  196.             END;
  197.           UNTIL end;
  198.         END;
  199.       END;
  200.     END;
  201.   END;
  202.  
  203. CLOSE
  204.  
  205.   FreeGadgetList(glw);
  206.   FreeGadgetList(glr);
  207.   FreeRequester(req);
  208.   FreeIntuiTextList(it);
  209.   DeleteWindow(win);
  210.   DeleteScreen(scr);
  211.  
  212. END IntuitionDemo.
  213.